home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / ARexxTools / fpl70.lha / src / statement.c < prev   
Encoding:
C/C++ Source or Header  |  1994-04-10  |  41.0 KB  |  1,600 lines
  1. /******************************************************************************
  2.  *                   FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  statement.c
  6.  
  7.  Support routines to the Expression() function.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <stdlib.h>
  44.  
  45. #include <proto/dos.h>
  46. #include <exec/execbase.h>
  47. #include <dos.h>
  48.  
  49. #include "/funclib/funclib.h"
  50.  
  51. #elif defined(UNIX)
  52. #include <sys/types.h>
  53. #endif
  54.  
  55. #include "script.h"
  56. #include <stdio.h>
  57. #include <stddef.h>
  58. #include <limits.h>
  59.  
  60. static ReturnCode INLINE SendMessage(struct Data *, struct fplMsg *);
  61. static ReturnCode INLINE Ltostr(struct Data *scr, struct fplStr **,
  62.                 long, long);
  63. static ReturnCode  GetSymbols(struct Data *, long, long, struct fplSymbol **);
  64.  
  65.  
  66. /**********************************************************************
  67.  *
  68.  * ReturnCode CmpAssign()
  69.  *
  70.  * Performs a compound assign to the value the third argument points to.
  71.  * The assign performed is the one with the operator specified in the fourth
  72.  * argument eg, x, +, /, &, %, | etc, etc...
  73.  *
  74.  ***************/
  75.  
  76. ReturnCode 
  77. CmpAssign(struct Data *scr,
  78.           long val,    /* right operand */
  79.       long *value,    /* return value pointer */
  80.       long flags,    /* variable flags */
  81.       char operation)
  82. {
  83.   ReturnCode ret;
  84.   switch(operation) { /* check the type of the assign */
  85.   case CHAR_PLUS:
  86.     if(scr->compiling)
  87.       COMPILE(COMP_CMPPLUS);
  88.     *value+=val;
  89.     break;
  90.   case CHAR_MINUS:
  91.     if(scr->compiling)
  92.       COMPILE(COMP_CMPMINUS);
  93.     *value-=val;
  94.     break;
  95.   case CHAR_MULTIPLY:
  96.     if(scr->compiling)
  97.       COMPILE(COMP_CMPMUL);
  98.     *value*=val;
  99.     break;
  100.   case CHAR_DIVIDE:
  101.     if(scr->compiling)
  102.       COMPILE(COMP_CMPDIV);
  103.     *value/=val;
  104.     break;
  105.   case CHAR_AND:
  106.     if(scr->compiling)
  107.       COMPILE(COMP_CMPAND);
  108.     *value&=val;
  109.     break;
  110.   case CHAR_OR:
  111.     if(scr->compiling)
  112.       COMPILE(COMP_CMPOR);
  113.     *value|=val;
  114.     break;
  115.   case CHAR_REMAIN:
  116.     if(scr->compiling)
  117.       COMPILE(COMP_CMPREMAIN);
  118.     *value%=val;
  119.     break;
  120.   case CHAR_XOR:
  121.     if(scr->compiling)
  122.       COMPILE(COMP_CMPXOR);
  123.     *value^=val;
  124.     break;
  125.   case CHAR_LESS_THAN:
  126.     if(scr->compiling)
  127.       COMPILE(COMP_CMPSHIFTL);
  128.     *value<<=val;
  129.     break;
  130.   case CHAR_GREATER_THAN:
  131.     if(scr->compiling)
  132.       COMPILE(COMP_CMPSHIFTR);
  133.     *value>>=val;
  134.     break;
  135.   case CHAR_ASSIGN:
  136.     if(scr->compiling)
  137.       COMPILE(COMP_ASSIGN);
  138.     *value=val;
  139.     break;
  140.   default:
  141.     CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN)); /* >warning< */
  142.     *value=val; /* perform a straight assign! */
  143.     break;
  144.   }
  145.   if(flags&FPL_VARIABLE_LESS32) {
  146.     /* if using less than 32 bit */
  147.     if(flags&FPL_CHAR_VARIABLE)
  148.       *value=(long)((signed char)*value);
  149.     else
  150.       *value=(long)((signed short)*value);
  151.   }
  152.   return(FPL_OK);
  153. }
  154.  
  155.  
  156. /**********************************************************************
  157.  *
  158.  * StrAssign();
  159.  *
  160.  * Assign a string variable.
  161.  *
  162.  ********/
  163.  
  164. ReturnCode 
  165. StrAssign(struct fplStr *app,
  166.           struct Data *scr,
  167.       struct fplStr **string,
  168.       char append) /* TRUE or FALSE if append */
  169. {
  170.   long ln;
  171.   long length;
  172.   long alloc;
  173.   long copylen;
  174.   void *dest;
  175.  
  176.   if(!append) { /* if not append */
  177.     /* Exchange this string with the old one in the variable! */
  178.     if(*string)
  179.       /* There is a string! */
  180.       FREE(*string);
  181.     if(!app) {
  182.       GETMEM(app, sizeof(struct fplStr));
  183.       memset(app, 0, sizeof(struct fplStr)); /* clean it! */
  184.     }
  185.     *string = app;
  186.   } else { /* append string */
  187.     copylen= app->len; /* length of append string */
  188.  
  189.     if(! copylen)
  190.       /* we don't append zero length strings! */
  191.       return FPL_OK;
  192.  
  193.     length=*string?(*string)->len:0;
  194.     alloc=*string?(*string)->alloc:0;
  195.  
  196.     ln=copylen+length; /* total length */
  197.     if (ln>=alloc) { /* do we have that much memory allocated? */
  198.       /*
  199.        * Allocate new memory for string.
  200.        */
  201.  
  202.       struct fplStr *pek;
  203.  
  204.       GETMEM(pek, sizeof(struct fplStr)+ln+ADDSTRING_INC);
  205.  
  206.       if(*string) {
  207.     memcpy(pek, (*string), length+sizeof(struct fplStr));
  208.     FREE(*string);
  209.       } else
  210.     pek->len=0;
  211. #ifdef DEBUG
  212.       CheckMem(scr, pek);
  213. #endif
  214.       (*string)=pek;              /* the new pointer */
  215.       (*string)->alloc=ln+ADDSTRING_INC;  /* new allocated size */
  216.     }
  217.  
  218.     dest=(void *)&(*string)->string[length];
  219.  
  220.     /* no string function... only mem-versions! */
  221.     memcpy(dest, (void *)app->string, copylen);
  222.  
  223.     (*string)->len+=copylen;
  224.   }
  225.   (*string)->string[(*string)->len]=CHAR_ASCII_ZERO; /* zero terminate */
  226.   return(FPL_OK);
  227. }
  228.  
  229.  
  230. /************************************************************************
  231.  *
  232.  * ReturnChar()
  233.  *
  234.  * Returns the ASCII code of the character scr->text points to.
  235.  *
  236.  * Supports 100% ANSI C escape sequences.
  237.  */
  238.  
  239. ReturnCode 
  240. ReturnChar(struct Data *scr,
  241.            long *num,
  242.            char string) /* is this is within quotes */
  243. {
  244.   ReturnCode ret=FPL_OK;
  245.   long cont=TRUE, steps;
  246.   *num=0;
  247.   while(cont) {
  248.     cont=FALSE;
  249.     if(*scr->text==CHAR_BACKSLASH) {
  250.       steps=2;
  251.       switch(scr->text[1]) {
  252.       case CHAR_B:
  253.     *num=CHAR_BACKSPACE;
  254.     break;
  255.       case CHAR_T:
  256.     *num=CHAR_TAB;
  257.     break;
  258.       case CHAR_N:
  259.     *num=CHAR_NEWLINE;
  260.     break;
  261.       case CHAR_F:
  262.     *num=CHAR_FORMFEED;
  263.     break;
  264.       case CHAR_BACKSLASH:
  265.     *num=CHAR_BACKSLASH;
  266.     break;
  267.       case CHAR_QUOTATION_MARK:
  268.     *num=CHAR_QUOTATION_MARK;
  269.     break;
  270.       case CHAR_APOSTROPHE:
  271.     *num=CHAR_APOSTROPHE;
  272.     break;
  273.       case CHAR_A:
  274.     *num=CHAR_ALERT;
  275.     /*   ^^^^ causes warnings ('warning: \a is ANSI C "alert" character')
  276.      * on some compilers. Ignore and look happy!
  277.      */
  278.     break;
  279.       case CHAR_R:
  280.     *num=CHAR_CARRIAGE_RETURN;
  281.     break;
  282.       case CHAR_V:
  283.     *num=CHAR_VERTICAL_TAB;
  284.     break;
  285.       case CHAR_QUESTION:
  286.     *num=CHAR_QUESTION;
  287.     break;
  288.       case CHAR_X:
  289.     steps=*num=0;
  290.     /* exchanged the sscanf() with this code below 921229-00:59 / DaSt */
  291.     for(scr->text+=2; steps++<2 && NUMBER(*scr->text) ||
  292.         *scr->text>=CHAR_A && *scr->text<=CHAR_F;
  293.         scr->text++)
  294.       *num=*num*16+ *scr->text - (*scr->text<CHAR_A?CHAR_ZERO:CHAR_A-10);
  295.     if(!steps)
  296.       return(FPLERR_SYNTAX_ERROR); /* no number followed \x sequence */
  297.     steps=0;
  298.     break;
  299.       case CHAR_ZERO:
  300.       case CHAR_ONE:
  301.       case CHAR_TWO:
  302.       case CHAR_THREE:
  303.       case CHAR_FOUR:
  304.       case CHAR_FIVE:
  305.       case CHAR_SIX:
  306.       case CHAR_SEVEN:
  307.     *num=steps=0;
  308.     /* octal number parser (added 921229-01:02 / DaSt) */
  309.     for(scr->text++;steps++<3 && *scr->text>=CHAR_ZERO &&
  310.         *scr->text<=CHAR_SEVEN;)
  311.       *num=*num*8+ *scr->text++ - CHAR_ZERO;
  312.     steps=0;
  313.     break;
  314.       case CHAR_NEWLINE:
  315.     /* After a line continuation backslash, a newline is required!
  316.        This is made to apply to the ANSI C escape sequence standard.
  317.        (added 930113-1305 / DaSt) */
  318.     cont=TRUE;
  319.     scr->virprg++;
  320.     break;
  321.       default:
  322.     /* Any character not identified as a escape sequence character
  323.        will simply ignore the backslah character!
  324.        (added 930113-1307 / DaSt) */
  325.     *num=*scr->text;
  326.     break;
  327.       }
  328.       scr->text+=steps;
  329.     } else if(!string && *scr->text=='\n') {
  330.       /* This won't occur if the script is preprocessed! */
  331.       cont=TRUE;
  332.       scr->text++;
  333.     } else if(*scr->text=='\0') {
  334.       /* This won't occur if the script is preprocessed! */
  335.       cont=TRUE;
  336.       CALL(Newline(scr));
  337.     } else {
  338.       *num=*scr->text;
  339.       scr->text++;
  340.     }
  341.   }
  342.   return(ret);
  343. }
  344.  
  345. /**********************************************************************
  346.  *
  347.  * ReturnCode NewMember(struct Expr **);
  348.  *
  349.  * This function adds a new member in the linked list which keeps
  350.  * track on every operand and it's opertor in the expression.
  351.  *
  352.  *******/
  353.  
  354. ReturnCode  NewMember(struct Data *scr, struct Expr **expr)
  355. {
  356.   GETMEM((*expr)->next, sizeof(struct Expr));
  357.  
  358.   (*expr)=(*expr)->next;
  359.   (*expr)->val.val=0;
  360.   (*expr)->unary=NULL;
  361.   (*expr)->operator=OP_NOTHING;
  362.   (*expr)->flags=FPL_OPERAND;
  363.   (*expr)->next=NULL;
  364.   return(FPL_OK);
  365. }
  366.  
  367.  
  368. /**********************************************************************
  369.  *
  370.  * ReturnCode Warn();
  371.  *
  372.  * This routines calls the interface function to ask for permission to
  373.  * continue the execution, even though error(s) has/have been found in
  374.  * the interpreted program.
  375.  *
  376.  ******/
  377.  
  378. ReturnCode  Warn(struct Data *scr, ReturnCode rtrn)
  379. {
  380.   struct fplArgument *pass;
  381.   struct fplMsg *msg;
  382.   ReturnCode ret;
  383.  
  384.   GETMEM(pass, sizeof(struct fplArgument));
  385.   pass->ID=FPL_WARNING;
  386.   pass->key=scr;
  387.   pass->argc=1;
  388.   pass->argv=(void **)&rtrn; /* first ->argv member holds the error/warning number! */
  389.  
  390.   ret=InterfaceCall(scr, pass, scr->function);
  391.  
  392.   FREE(pass);
  393.   GetMessage(scr, FPLMSG_CONFIRM, &msg);
  394.   if(msg) {
  395.     if(msg->message[0]) {
  396.       rtrn=ret;
  397.       scr->prog->warnings++;
  398.     }
  399.     DeleteMessage(scr, msg);
  400.   }
  401.   return(rtrn);
  402. }
  403.  
  404.  
  405. /**********************************************************************
  406.  *
  407.  * fplSend()
  408.  *
  409.  * Send a message to FPL.
  410.  *
  411.  ******/
  412.  
  413. ReturnCode PREFIX fplSend(AREG(0) struct Data *scr,
  414.               AREG(1) unsigned long *tags)
  415. {
  416.   struct fplMsg msg;
  417.   long len=-1;
  418.   struct Program *prog;
  419.   char *data=NULL;
  420.   ReturnCode ret;
  421.   struct fplSymbol *symbol;
  422.   struct fplStr *string;
  423.   long mixed;
  424.   char fplallocstring=FALSE;
  425.   if(!scr)
  426.     return(FPLERR_ILLEGAL_ANCHOR);
  427.  
  428.   memset(&msg, 0, sizeof(struct fplMsg));
  429.  
  430.   while(tags && *tags) {
  431.     switch(*tags++) {
  432.     case FPLSEND_STRING:
  433.       /* FPLSEND_PROGRAMFILE is the same tag */
  434.       data=(void *)*tags;
  435.       msg.type=FPLMSG_RETURN_STRING;
  436.       break;
  437.     case FPLSEND_STRLEN:
  438.       len=(long)*tags;
  439.       break;
  440.     case FPLSEND_DONTCOPY_STRING: /* the string sent is fplAllocString()'ed */
  441.       fplallocstring=(char)*tags;
  442.       break;
  443.     case FPLSEND_INT:
  444.       msg.message[0]=(void *)*tags;
  445.       msg.type=FPLMSG_RETURN_INT;
  446.       break;
  447.     case FPLSEND_PROGRAM:
  448.       msg.message[0]=(void *)*tags;
  449.       msg.type=FPLMSG_PROGRAM;
  450.       break;
  451.     case FPLSEND_CONFIRM:
  452.       msg.type=FPLMSG_CONFIRM;
  453.       msg.message[0]=(void *)*tags;
  454.       break;
  455.     case FPLSEND_GETINTERVAL:
  456.       *(long *)*tags=(long)scr->interfunc;
  457.       break;
  458.     case FPLSEND_GETFUNCTION:
  459.       *(long *)*tags=(long)scr->function;
  460.       break;
  461.     case FPLSEND_GETLINE:
  462.       *(long *)*tags=scr->prg;
  463.       break;
  464.     case FPLSEND_GETVIRFILE:
  465.       *(char **)*tags=scr->virfile;
  466.       break;
  467.     case FPLSEND_GETVIRLINE:
  468.       *(long *)*tags=scr->virprg;
  469.       break;
  470.     case FPLSEND_GETNEWLINE_HOOK:
  471.       *(long *)*tags=(long)scr->newline_hook;
  472.       break;
  473.     case FPLSEND_GETRESULT:
  474.       *(long *)*tags=scr->data;
  475.       break;
  476.     case FPLSEND_GETRETURNCODE:
  477.       *(long *)*tags=scr->FPLret;
  478.       break;
  479.     case FPLSEND_GETUSERDATA:
  480.       *(long *)*tags=(long)scr->userdata;
  481.       break;
  482.     case FPLSEND_GETCOLUMN:
  483.       if(scr->prog && scr->prog->running)
  484.     *(long *)*tags=(scr->text-(&scr->prog->program)[scr->prg-1]+1);
  485.       else if(scr->prog)
  486.     /* we cannot count on this programs presence */
  487.     *(long *)*tags=scr->prog->column;
  488.       else
  489.     *(long *)*tags=0; /* we don't know! */
  490.       break;
  491.     case FPLSEND_GETPROGNAME:
  492.       if(scr->prog && scr->prog->name)
  493.     *(char **)*tags=scr->prog->name;
  494.       else /* we have no program information */
  495.     *(char **)*tags=FPLTEXT_UNKNOWN_PROGRAM;
  496.       break;
  497.     case FPLSEND_GETPROG:
  498.       if(scr->prog && scr->prog->program)
  499.     *(char **)*tags=scr->prog->program;
  500.       else /* we have no program information */
  501.     *(char **)*tags=NULL;
  502.       break;
  503.     case FPLSEND_FLUSHCACHE:
  504.       if(*tags)
  505.     FlushFree(scr);
  506.       break;
  507.     case FPLSEND_FLUSHFILE:
  508.       if(*tags) {
  509.     prog=scr->programs;
  510.     while(prog) {
  511.       if(!strcmp(prog->name, (char *)*tags))
  512.         break;
  513.       prog=prog->next;
  514.     }
  515.     if(!prog)
  516.       return(FPLERR_INTERNAL_ERROR);
  517.       } else
  518.     prog=scr->programs;
  519.       while(prog) {
  520.     if(!(prog->running)) {
  521.       /* if the program isn't running right now! */
  522.       len=prog->flags;
  523.       prog->flags&=~PR_CACHEFILE; /* switch off the cache bit now */
  524.       CALL(LeaveProgram(scr, prog));
  525.       prog->flags=len; /* restore flag bits! */
  526.     }
  527.     if(*tags)
  528.       /* only the specified */
  529.       break;
  530.     prog=prog->next;
  531.       }
  532.       break;
  533.     case FPLSEND_FREEFILE:
  534.       prog=scr->programs;
  535.       while(prog) {
  536.     if(!strcmp(prog->name, (char *)*tags))
  537.       break;
  538.     prog=prog->next;
  539.       }
  540.       if(!prog || prog->running || prog->openings)
  541.     /* if not found or if the found one is currently in use! */
  542.     return(FPLERR_ILLEGAL_PARAMETER);
  543.  
  544.       CALL(GetSymbols(scr, FPL_INSIDE_FUNCTION, ~0, &symbol));
  545.       for(mixed=0; mixed<symbol->num; mixed++)
  546.     if(!strcmp(symbol->array[mixed], (char *)*tags))
  547.       DelIdentifier(scr, symbol->array[mixed], NULL);
  548.       DelProgram(scr, prog);
  549.       FREE(symbol->array);
  550.       FREE(symbol);
  551.       break;
  552.     case FPLSEND_STEP:
  553.       if(*tags>0) {
  554.     while((*tags)--) {
  555.       if(!*scr->text)
  556.         CALL(Newline(scr));
  557.       scr->text++;
  558.     }
  559.       } else if((signed int)(*tags)<0) {
  560.     while((*tags)++) {
  561.       if( (scr->text-(&scr->prog->program)[scr->prg-1])>=0)
  562.         scr->text--;
  563.       else
  564.         if(scr->prg>1)
  565.           scr->text=(&scr->prog->program)[--scr->prg-1];
  566.         else
  567.           return(FPLERR_UNEXPECTED_END);
  568.     }
  569.       }
  570.       break;
  571.     case FPLSEND_GETSYMBOL_FUNCTIONS:
  572.       CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION|FPL_EXPORT_SYMBOL,
  573.               FPL_FUNCTION,
  574.               (struct fplSymbol **)*tags));
  575.       break;
  576.     case FPLSEND_GETSYMBOL_MYFUNCTIONS:
  577.       CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION, FPL_FUNCTION,
  578.               (struct fplSymbol **)*tags));
  579.       break;
  580.     case FPLSEND_GETSYMBOL_FPLFUNCTIONS:
  581.       CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_INSIDE_FUNCTION,
  582.               (struct fplSymbol **)*tags));
  583.       break;
  584.     case FPLSEND_GETSYMBOL_VARIABLES:
  585.       CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_VARIABLE,
  586.               (struct fplSymbol **)*tags));
  587.       break;
  588.     case FPLSEND_GETSYMBOL_ALLVARIABLES:
  589.       CALL(GetSymbols(scr, ~0, FPL_VARIABLE, (struct fplSymbol **)*tags));
  590.       break;
  591.  
  592.     case FPLSEND_GETSYMBOL_ALLFUNCTIONS:
  593.       CALL(GetSymbols(scr, ~0, FPL_FUNCTION, (struct fplSymbol **)*tags));
  594.       break;
  595.  
  596.     case FPLSEND_GETSYMBOL_CACHEDFILES:
  597.       prog=scr->programs;
  598.       mixed=0;
  599.       while(prog) {
  600.     if(prog->flags&PR_CACHEFILE)
  601.       mixed++;
  602.     prog=prog->next;
  603.       }
  604.  
  605.       GETMEM(symbol, sizeof(struct fplSymbol));
  606.       symbol->num=mixed;
  607.       GETMEM(symbol->array, mixed*sizeof(char *));
  608.  
  609.       mixed=0;
  610.       prog=scr->programs;
  611.       while(prog) {
  612.     if(prog->flags&PR_CACHEFILE)
  613.       symbol->array[mixed++]=prog->name;
  614.     prog=prog->next;
  615.       }
  616.       *(struct fplSymbol **)*tags=symbol;
  617.  
  618. #ifdef DEBUG
  619.       CheckMem(scr, symbol);
  620.       CheckMem(scr, symbol->array);
  621. #endif
  622.  
  623.       break;
  624.     case FPLSEND_GETSYMBOL_FREE:
  625. #ifdef DEBUG
  626.       CheckMem(scr, (void *)(*tags));
  627.       CheckMem(scr, ((struct fplSymbol *)*tags)->array);
  628. #endif
  629.       FREE(((struct fplSymbol *)*tags)->array);
  630.       FREE(*tags);
  631.       break;
  632.  
  633. #if defined(AMIGA) && defined(SHARED)
  634.     case FPLSEND_GETSTACKSIZE:
  635.       *(long *)*tags=GetStackSize(scr);
  636.       break;
  637.     case FPLSEND_GETSTACKUSED:
  638.       *(long *)*tags=GetStackUsed(scr);
  639.       break;
  640. #endif
  641.     case FPLSEND_SETPROGNAME:
  642.       if(scr->prog) {
  643.     if(scr->prog->name)
  644.       FREEA(scr->prog->name);
  645.     STRDUPA(scr->prog->name, *tags);
  646.       }
  647.       break;
  648.     case FPLSEND_SETFILENAMEGET:
  649.       if(scr->prog) {
  650.     if(*tags)
  651.       scr->prog->flags|=PR_FILENAMEFLUSH;
  652.     else
  653.       scr->prog->flags&=~PR_FILENAMEFLUSH;
  654.       }
  655.       break;
  656.     }
  657.     tags++;
  658.   }
  659.   if(!msg.type)
  660.     /*
  661.      * There is no message to send. Everything we had to do is done!
  662.      */
  663.     return(FPL_OK);
  664.  
  665.   if(msg.type==FPLMSG_RETURN_STRING) {
  666.     if(len<0)
  667.       if(data)
  668.     len=strlen(data);
  669.     if(!len || !data)
  670.       /* this really is a zero length string! */
  671.       msg.message[0]=NULL;
  672.     else {
  673.       if(!fplallocstring) {
  674.         /* we have to duplicate the data */
  675.         GETMEM(msg.message[0], len+sizeof(struct fplStr));
  676.         string=msg.message[0];
  677.         string->len=len;
  678.         string->alloc=len;
  679.         memcpy(string->string, data, len); /* copy string! */
  680.         string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
  681.       } else {
  682.         /* the data was sent as fplAllocString() data! */
  683.         string= (struct fplStr *)(data - offsetof(struct fplStr, string));
  684.         string->len=len;
  685.         string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
  686.         SwapMem(scr, string, MALLOC_DYNAMIC); /* convert */
  687.         msg.message[0]=string;
  688.       }
  689.     }
  690.   }
  691.   CALL(SendMessage(scr, &msg));
  692.   return(ret);
  693. }
  694.  
  695.  
  696. /*********************************************************************
  697.  *
  698.  * fplConvertString()
  699.  *
  700.  * Returns the number of characters converted from the FPL format
  701.  * string to the binary sting stored in a buffer.
  702.  *
  703.  * The output string always get zero terminated!
  704.  *
  705.  *****/
  706.  
  707. long PREFIX fplConvertString(AREG(0) struct Data *scr,
  708.                  AREG(1) char *string,
  709.                  AREG(2) char *buffer)
  710. {
  711.   long prg=scr->prg;
  712.   char *text=scr->text;
  713.   long line;
  714.   char *base;
  715.   long a;
  716.   long number=0;
  717.  
  718.   if(!scr->prog) {
  719.     /*
  720.      * There is no program at the moment!
  721.      * create a pseudo program for now!
  722.      */
  723.     scr->prog=(struct Program *)MALLOC(sizeof(struct Program));
  724.     if(!scr->prog)
  725.       return(0); /* no characters in output! */
  726.     scr->prog->flags|=PR_TEMPORARY;
  727.   }
  728.   
  729.   base=scr->prog->name;
  730.   line=scr->prog->lines;
  731.   if(*string==CHAR_QUOTATION_MARK)
  732.     string++;
  733.  
  734.   scr->prg=1;
  735.   scr->text=string;
  736.   scr->prog->lines=1;
  737.   scr->prog->name=NULL; /* we have no file ID yet! */
  738.  
  739.   while(*scr->text!=CHAR_QUOTATION_MARK &&
  740.     !ReturnChar(scr, &a, TRUE)) { /* returns non-zero when an ascii zero is
  741.                          found! */
  742.     *buffer++=a;
  743.     number++;
  744.   }
  745.   
  746.   *buffer=CHAR_ASCII_ZERO;
  747.  
  748.   scr->prg=prg;
  749.   scr->text=text;
  750.   scr->prog->lines=line;
  751.   scr->prog->name=base;
  752.   
  753.   if(scr->prog->flags&PR_TEMPORARY) {
  754.     FREE(scr->prog);
  755.     scr->prog=NULL;
  756.   }
  757.  
  758.   return(number);
  759. }
  760.  
  761. /**********************************************************************
  762.  *
  763.  * GetSymbols();
  764.  *
  765.  * Allocates a structure and data, which is a list of name pointers
  766.  * that match the flag parameter.
  767.  *
  768.  *******/
  769.  
  770. static ReturnCode 
  771. GetSymbols(struct Data *scr,
  772.            long flag1,
  773.            long flag2,
  774.            struct fplSymbol **get)
  775. {
  776.   long i;
  777.   long num;
  778.   struct Identifier *ident;
  779.   struct fplSymbol *symbol;
  780.  
  781.   for(i=num=0; i<FPL_HASH_SIZE; i++) {
  782.     ident=scr->hash[i];
  783.     while(ident) {
  784.       if(ident->flags&flag1 && ident->flags&flag2)
  785.     num++;
  786.       ident=ident->next;
  787.     }
  788.   }
  789.  
  790.   GETMEM(symbol, sizeof(struct fplSymbol));
  791.   symbol->num=num;
  792.  
  793.   GETMEM(symbol->array, sizeof(char *)*symbol->num);
  794.  
  795.   for(i=num=0; i<FPL_HASH_SIZE; i++) {
  796.     ident=scr->hash[i];
  797.     while(ident) {
  798.       if(ident->flags&flag1 && ident->flags&flag2)
  799.     symbol->array[num++]=ident->name;
  800.       ident=ident->next;
  801.     }
  802.   }
  803.   *get=symbol;
  804.  
  805. #ifdef DEBUG
  806.   CheckMem(scr, symbol->array);
  807. #endif
  808.   return(FPL_OK);
  809. }
  810.  
  811.  
  812. /**********************************************************************
  813.  *
  814.  * SendMessage();
  815.  *
  816.  * Add a member to the message queue. Allocate a new struct and copy the
  817.  * data of from second parameter message pointer.
  818.  *
  819.  ******/
  820.  
  821. static ReturnCode INLINE SendMessage(struct Data *scr, struct fplMsg *msg)
  822. {
  823.   struct fplMsg *NewMsg, *ptr;
  824.  
  825.   GETMEM(NewMsg, sizeof(struct fplMsg));
  826.  
  827.   *NewMsg=*msg; /* copy all data from source */
  828.  
  829.   /* Queue the message: */
  830.   if(ptr=scr->msg)
  831.     ptr->prev=NewMsg; /* this message becomes the previous for this */
  832.  
  833.   scr->msg=NewMsg;
  834.   NewMsg->next=ptr;
  835.   NewMsg->prev=NULL; /* no previous, this is first! */
  836.  
  837.   return(FPL_OK);
  838. }
  839.  
  840. /**********************************************************************
  841.  *
  842.  * DeleteMessage();
  843.  *
  844.  * Deletes specified or current message (NULL).
  845.  *
  846.  *****/
  847.  
  848. ReturnCode  DeleteMessage(struct Data *scr, struct fplMsg *msg)
  849. {
  850.   struct fplMsg *ptr=scr->msg;
  851.   if(msg) 
  852.     ptr=msg;
  853.   if(ptr) {
  854.     if(ptr->next)
  855.       ptr->next->prev=ptr->prev; /* redirect next message's prev pointer */
  856.     else if(!ptr->prev) /* is this the only message? */
  857.       scr->msg=NULL;
  858.     if(ptr->prev)
  859.       ptr->prev->next=ptr->next; /* redirect previous message's next pointer */
  860.     FREE(ptr);  /* free message */
  861.   }
  862.   return(FPL_OK);
  863. }
  864.  
  865. /**********************************************************************
  866.  *
  867.  * GetMessage()
  868.  *
  869.  * Returns the first message of the requested type in the pointer
  870.  * in the third argument!
  871.  *
  872.  ****/
  873.  
  874. ReturnCode  GetMessage(struct Data *scr, char type, struct fplMsg **get)
  875. {
  876.   struct fplMsg *msg=scr->msg;
  877.   while(*get=msg) {
  878.     if(msg->type==type)
  879.       break;
  880.     msg=msg->next;
  881.   }
  882.   return(FPL_OK);
  883. }
  884.  
  885. /**********************************************************************
  886.  *
  887.  * GetProgram();
  888.  *
  889.  * Whenever we want to access a program in the program list, we do it
  890.  * using this function. This enables heavy program swapping capabilities.
  891.  * Programs that are not being used can be flushed from memory and brought
  892.  * back whenever we need it!
  893.  *
  894.  ******/
  895.  
  896. ReturnCode  GetProgram(struct Data *scr, struct Program *prog)
  897. {
  898.   struct fplArgument *arg;
  899.   ReturnCode ret;
  900.   struct fplMsg *msg;
  901.   struct fplStr *string;
  902.   if(!prog->program) {
  903.     /*
  904.      * The program is not currently in memory. Get it!
  905.      */
  906.     
  907.     if(prog->flags&PR_FILENAMEFLUSH) {
  908.       /*
  909.        * We know that the program is simply to load from the file the program
  910.        * name specifies.
  911.        */
  912.       CALL(ReadFile(scr, prog->name, prog));
  913.     } else {
  914.       /*
  915.        * We must ask user for information!
  916.        */
  917.       
  918.       GETMEM(arg, sizeof(struct fplArgument));
  919.       arg->ID=FPL_FILE_REQUEST;
  920.       arg->key=(void *)scr;
  921.       arg->argv=(void **)&prog->name;
  922.       arg->argc=1;
  923.       CALL(InterfaceCall(scr, arg, scr->function));
  924.       FREE(arg);
  925.       
  926.       GetMessage(scr, FPLMSG_PROGRAM, &msg);
  927.       if(!msg) {
  928.     GetMessage(scr, FPLMSG_RETURN_STRING, &msg);
  929.     if(!msg)
  930.       /*
  931.        * No kind of proper answer could be found!
  932.        * Dead end failure!
  933.        */      
  934.       return(FPLERR_INTERNAL_ERROR);
  935.     
  936.     string=(struct fplStr *)msg->message[0];
  937.     CALL(ReadFile(scr, string->string, prog));
  938.     FREE(msg->message[0]); /* we don't need this anymore! */
  939.       } else {
  940.     /*
  941.      * User supplied us with a memory pointer to the program again!
  942.      */
  943.     prog->program= (char *)msg->message[0];
  944.     prog->flags|=PR_USERSUPPLIED;
  945.       }
  946.       DeleteMessage(scr, msg);
  947.     }
  948.   } /* else
  949.        we already have it loaded! */
  950.   prog->running++;
  951.   return(FPL_OK);
  952. }
  953.  
  954.  
  955. /**********************************************************************
  956.  *
  957.  * LeaveProgram();
  958.  *
  959.  * If we leave one program, call this. If any flush is to be done, this
  960.  * will perform that!
  961.  *
  962.  ******/
  963.  
  964. ReturnCode  LeaveProgram(struct Data *scr, struct Program *prog)
  965. {
  966.   struct fplArgument *arg;
  967.   ReturnCode ret;
  968.   struct fplMsg *msg;
  969.   prog->running--;
  970.   if(prog->program && !prog->running && !(prog->flags&PR_CACHEFILE)) {
  971.     /*
  972.      * The program is there and no one is using it!
  973.      * flush it if we want to!
  974.      */
  975.  
  976.     if(prog->flags&PR_USERSUPPLIED) {
  977.       /*
  978.        * This program is supplied by the external program. We cannot
  979.        * free the memory, only tell our father that freeing is OK...
  980.        */
  981.       GETMEM(arg, sizeof(struct fplArgument));
  982.       arg->ID=FPL_FLUSH_FILE;
  983.       arg->key=(void *)scr;
  984.       arg->argv=(void **)&prog->name;
  985.       arg->argc=1;
  986.       CALL(InterfaceCall(scr, arg, scr->function));
  987.       FREE(arg);
  988.       GetMessage(scr, FPLMSG_CONFIRM, &msg);
  989.       /*
  990.        * We require a {FPLSEND_CONFIRM, TRUE} message from the user before we
  991.        * flush the user supplied function! Simply ignore implementing any
  992.        * answer to this message if we never want to flush user supplied
  993.        * functions.
  994.        */
  995.       if(msg && msg->message[0])
  996.     /* If we got a "OK" message! */
  997.     prog->program=NULL;
  998.       if(msg)
  999.     DeleteMessage(scr, msg);
  1000.     } else {
  1001.       /*
  1002.        * The memory occupied by this program is our business.
  1003.        * Swap the memory first to be sure we know the kind of it!
  1004.        */
  1005.       SwapMem(scr, prog->program, MALLOC_DYNAMIC);
  1006.       FREE(prog->program);
  1007.       prog->program=NULL; /* to visualize the clearing of this program! */
  1008.     }
  1009.   }
  1010.   return(FPL_OK);
  1011. }
  1012.  
  1013. /**********************************************************************
  1014.  *
  1015.  * int functions(struct fplArgument *);
  1016.  *
  1017.  * This function handles the internal functions. *EXACTLY* the same way
  1018.  * external processes handles their functions!!! :-)
  1019.  *
  1020.  *****/
  1021.  
  1022. ReturnCode  functions(struct fplArgument *arg)
  1023. {
  1024.   struct Expr val;
  1025.   unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  1026.   unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0, FPLSEND_DONE};
  1027.   long base;
  1028.   ReturnCode ret;
  1029.   struct Data *scr=(struct Data *)arg->key;
  1030.   struct fplStr *string;
  1031.   long prg;
  1032.   long line;
  1033.   long virprg;
  1034.   char *virfile;
  1035.   char *text;
  1036. /*  char *file; */
  1037.   long len;        /* length of the string */
  1038.   register long col;    /* the column parameter */
  1039.   switch(arg->ID) {
  1040.     
  1041.   case FNC_ABS:
  1042.     inttags[1]= ABS((long)arg->argv[0]);
  1043.     CALL(fplSend(arg->key, inttags));
  1044.     break;
  1045.  
  1046.   case FNC_ITOC:
  1047.     prg=(long)arg->argv[0]&255;
  1048.     text=(char *)&line; /* we just need 2 bytes to play with in peace! */
  1049.     text[1]='\0';
  1050.     text[0]=prg;
  1051.     strtags[1]=(long)text;
  1052.     strtags[3]=1;
  1053.     CALL(fplSend(scr, strtags));
  1054.     break;
  1055.     
  1056.   case FNC_JOINSTR:
  1057.     string=NULL;
  1058.     for(prg=0; prg<arg->argc; prg++) {
  1059.       CALL(StrAssign((struct fplStr *) ((char *)arg->argv[prg]-
  1060.                     offsetof(struct fplStr, string)),
  1061.              scr, &string, TRUE));
  1062.     }
  1063.     if(string) {
  1064.       strtags[1]=(unsigned long)string->string;
  1065.       strtags[3]=string->len;
  1066.       CALL(fplSend(scr, strtags));
  1067.       FREE(string);
  1068.     }
  1069.     break;
  1070.  
  1071.   case FNC_ITOA:
  1072.   case FNC_LTOSTR:
  1073.     base=(arg->argc<2?10:(long)arg->argv[1]);
  1074.     CALL(Ltostr(scr, &string, base, (long)arg->argv[0]));
  1075.     strtags[1]=(unsigned long)string->string;
  1076.     strtags[3]=string->len;
  1077.     CALL(fplSend(scr, strtags));
  1078.     FREE(string);
  1079.     break;
  1080.     
  1081.   case FNC_ATOI:
  1082.   case FNC_STRTOL:
  1083.     base=(arg->argc<2?10:(long)arg->argv[1]);
  1084.     inttags[1]= Strtol((char *)arg->argv[0], base, &text);
  1085.     CALL(fplSend(scr, inttags));
  1086.     break;
  1087.     
  1088.   case FNC_EVAL:
  1089.     prg=scr->prg;
  1090.     text=scr->text;
  1091.     line=scr->prog->lines;
  1092.     virprg=scr->virprg;
  1093.     virfile=scr->virfile;
  1094.  
  1095.     scr->virprg=1;
  1096.     scr->virfile=NULL;
  1097.     scr->text=(char *)arg->argv[0];
  1098.     scr->prg=scr->prog->lines=1;
  1099.  
  1100.     CALL(Expression(&val, scr, CON_GROUNDLVL|CON_END|CON_NUM, NULL));
  1101.  
  1102.     scr->prg=prg;
  1103.     scr->text=text;
  1104.     scr->prog->lines=line;
  1105.     scr->virprg=virprg;
  1106.     scr->virfile=virfile;
  1107.     
  1108.     inttags[1]=val.val.val;
  1109.     CALL(fplSend(scr, inttags));
  1110.     break;
  1111.     
  1112.   case FNC_INTERPRET:
  1113.     prg=scr->prg;
  1114.     text=scr->text;
  1115.     line=scr->prog->lines;
  1116. /*    file=scr->prog->name; */
  1117.     virprg=scr->virprg;
  1118.     virfile=scr->virfile;
  1119.     scr->virprg=1;
  1120.     scr->virfile=NULL;
  1121.     scr->interpret=NULL; /* nothing recursive here, no no! */
  1122.     scr->prg=1;
  1123.     scr->text=(char *)arg->argv[0];
  1124.     scr->prog->lines=1;
  1125. /*    scr->prog->name=NULL; */ /* we have no file name! */
  1126.     ret=Script(scr, &val, SCR_NORMAL, NULL);
  1127.     if(ret) {
  1128.       /*
  1129.        * Check if the error occurred somewhere in the real program
  1130.        * or if it was within the argument. If within argument, we
  1131.        * set back the previous program pointer, otherwise not.
  1132.        */
  1133.       for(base=0;base<line;base++)
  1134.     if(scr->text>(&scr->prog->program)[base] &&
  1135.        scr->text<((&scr->prog->program)[base]+
  1136.               strlen((&scr->prog->program)[base])))
  1137.       break;
  1138.       if(base==line) {
  1139.     scr->prg=prg;
  1140.     scr->text=text;
  1141.     scr->prog->lines=line;
  1142. /*    scr->prog->name=file; */
  1143.       }
  1144.       return(ret);
  1145.     }
  1146.     scr->prg=prg;
  1147.     scr->text=text;
  1148.     scr->prog->lines=line;
  1149. /*    scr->prog->name=file; */
  1150.     scr->virprg=virprg;
  1151.     scr->virfile=virfile;
  1152.     inttags[1]=val.val.val;
  1153.     CALL(fplSend(arg->key, inttags));
  1154.     break;
  1155.     
  1156.   case FNC_STRCMP:
  1157.     /*
  1158.      * strcmp() with strings that can include a zero byte must use
  1159.      * memcmp(), but that also takes a third length argument which
  1160.      * must never be larger than the smallest of the two compared
  1161.      * strings!
  1162.      */
  1163.     if(FPL_STRING_LENGTH(arg, 0) == FPL_STRING_LENGTH(arg, 1))
  1164.       inttags[1]=memcmp(arg->argv[0], arg->argv[1], FPL_STRING_LENGTH(arg, 0));
  1165.     else {
  1166.       /*
  1167.        * If the strings are of different length:
  1168.        *
  1169.        * o Get the min length. That is how long we should check at maximum.
  1170.        *                     LOOP:
  1171.        * o Have we passed to the last check point? Are we at the end of one
  1172.        *   of the strings?
  1173.        * NO:
  1174.        *   DIFF = char from string one - char from string two
  1175.        * YES:
  1176.        *   DIFF = char from string one (zero if this is the end of string one)
  1177.        *          minus
  1178.        *          (is this the end of string two?)
  1179.        *          YES: 0
  1180.        *          NO: char from string two
  1181.        *   if 'DIFF' is 0, DIFF = 256;
  1182.        * o Increase the string position counter.
  1183.        * o If DIFF != 0, then goto LOOP
  1184.        */
  1185.  
  1186.       prg = 0;  /* pos */
  1187.       line = MIN(FPL_STRING_LENGTH(arg, 0), FPL_STRING_LENGTH(arg, 1)); /* len */
  1188.       do {
  1189.     if(line > prg)
  1190.           base = ((char *)arg->argv[0])[prg] -
  1191.             ((char *)arg->argv[1])[prg];
  1192.     else {
  1193.       base = ((char *)arg->argv[0])[prg] -
  1194.         (FPL_STRING_LENGTH(arg, 1)>prg?
  1195.           ((char *)arg->argv[1])[prg] : 0 );
  1196.  
  1197.       if(!base) {
  1198.         /* only possible since FPL strings can hold zeroes! */
  1199.         base = 256; /* not possible in regular C */
  1200.       }
  1201.         }
  1202.     prg++;
  1203.       } while(!base);
  1204.  
  1205.       inttags[1]=base;
  1206.     }
  1207.     CALL(fplSend(scr, inttags));
  1208.     break;
  1209.     
  1210.   case FNC_SUBSTR:
  1211.     len=FPL_STRING_LENGTH(arg, 0);
  1212.     col=(long)arg->argv[1];
  1213.     if(col>len || col<0) {
  1214.       strtags[1]=(unsigned long)NULL;    /* we can't get any string! */
  1215.     } else {
  1216.       len-=col;            /* Maximum length we can get */
  1217.       strtags[3]=((long)arg->argv[2]>len?len:(long)arg->argv[2]); /* strlen */
  1218.       strtags[1]=(long) arg->argv[0]+col; /* return string from here */
  1219.     }
  1220.     CALL(fplSend(scr, strtags));
  1221.     break;
  1222.     
  1223.   case FNC_STRLEN:
  1224.     inttags[1]=FPL_STRING_LENGTH(arg, 0);
  1225.     CALL(fplSend(scr, inttags));
  1226.     break;
  1227.  
  1228.   case FNC_STRNCMP:
  1229.     /*
  1230.      * strncmp() with strings that can include a zero byte must use
  1231.      * memcmp(), that also takes a third length argument which
  1232.      * must never be larger than the smallest of the two compared
  1233.      * strings or the number specified!
  1234.      */
  1235.     inttags[1]=
  1236.       memcmp(arg->argv[0], arg->argv[1],
  1237.          MIN3((long)arg->argv[2],
  1238.           FPL_STRING_LENGTH(arg, 0), FPL_STRING_LENGTH(arg, 1)));
  1239.     CALL(fplSend(scr, inttags));
  1240.     break;
  1241.     
  1242.   case FNC_STRSTR:
  1243.     /*
  1244.      * strstr() has no memory version that could use zero inside
  1245.      * the two memory areas. Code an own! (I).
  1246.      */
  1247.     text=(char *)strstr((char *)arg->argv[0], (char *)arg->argv[1]);
  1248.     inttags[1]=text?text-(char *)arg->argv[0]:-1;
  1249.     CALL(fplSend(scr, inttags));
  1250.     break;
  1251.  
  1252. #if defined(AMIGA)
  1253.   case FNC_OPENLIB:
  1254.     CALL(OpenLib(scr,
  1255.                  (char *)arg->argv[0], /* name */
  1256.                  (long)arg->argv[1],   /* version */
  1257.                  (long *)&inttags[1],  /* funclib result */
  1258.                  0));                  /* normal 'soft' open */
  1259.     CALL(fplSend(scr, inttags));
  1260.     break;
  1261.  
  1262.   case FNC_CLOSELIB:
  1263.     CALL(CloseLib(scr,
  1264.                   (char *)arg->argv[0],  /* name */
  1265.                   0,                     /* 'soft' close */
  1266.                   (long *)&inttags[1])); /* funclib result */
  1267.     CALL(fplSend(scr, inttags));
  1268. #endif
  1269.   }
  1270.   return(FPL_OK);
  1271. }
  1272.  
  1273. #if defined(AMIGA)
  1274. ReturnCode REGARGS OpenLib(struct Data *scr,
  1275.                            char *lib,        /* funclib name */
  1276.                            long version,     /* funclib version */
  1277.                            long *retvalue,   /* funclib return code */
  1278.                            char flags)
  1279. {
  1280.    struct MyLibrary *library;
  1281.    struct Library *DOSBase;
  1282.    BPTR seglist;
  1283.    char *command;
  1284.    char *cmd;
  1285.    struct FuncList *namelist=scr->funclibs;
  1286.    char *name;
  1287.    ReturnCode ret;
  1288.    struct fplStr *string;
  1289.  
  1290.    struct ExecBase *SysBase = *(struct ExecBase **)4;
  1291.  
  1292.    library = (struct MyLibrary *)getreg(REG_A6);
  1293.    DOSBase = library->ml_DosBase;
  1294.  
  1295.    GETMEM(command, 60);
  1296.  
  1297.    while(namelist) {
  1298.      if(!strcmp(namelist->name, lib)) {
  1299.        namelist->opens++;
  1300.        return FPL_OK; /* this funclib is already opened */
  1301.      }
  1302.      namelist = namelist->next;
  1303.    }
  1304.  
  1305.    cmd = command;
  1306.    strcpy(command, FPLLIB_SOURCE);
  1307.    strcpy(command+strlen(FPLLIB_SOURCE), lib);
  1308.    seglist = LoadSeg(command); /* load the command! */
  1309.    if(seglist) {
  1310.      strcpy(command, FPLLIB_OPENCMD);
  1311.      command += strlen(FPLLIB_OPENCMD);
  1312.  
  1313.      CALL(Ltostr(scr, &string, 10, (long)scr));
  1314.      strcpy(command, string->string);
  1315.      command[string->len]= ' '; /* pad with a single space */
  1316.      command+=string->len+1;
  1317.      FREE(string);
  1318.  
  1319.      CALL(Ltostr(scr, &string, 10, version));
  1320.      strcpy(command, string->string);
  1321.      command[string->len]= '\n';   /* add newline */
  1322.      command[string->len+1]= '\0'; /* zero terminate */
  1323.      FREE(string);
  1324.  
  1325.      if(SysBase->SoftVer<36) {
  1326.        /* V33 solution! */
  1327.        char *segment = BADDR(seglist);
  1328.        int (*func)();
  1329. #pragma msg 147 ignore
  1330.        func = segment + 4; /* generates warning */
  1331. #pragma msg 147 warning
  1332.  
  1333.        putreg(REG_A0, (long)cmd);
  1334.        putreg(REG_D0, strlen(cmd));
  1335. #pragma msg 154 ignore
  1336.        *retvalue = (func)(); /* generates warning */
  1337. #pragma msg 154 warning
  1338.      } else /* version 36 or up! */
  1339.        *retvalue = RunCommand(seglist, 4000, cmd, strlen(cmd));
  1340.  
  1341.      UnLoadSeg( seglist );
  1342.    } else {
  1343.      /* we failed loading the command! */
  1344.      *retvalue = FUNCLIB_LOAD;
  1345.    }
  1346.  
  1347.    FREE(cmd);
  1348.  
  1349.    if(!*retvalue) {
  1350.       GETMEM(namelist, sizeof(struct FuncList));
  1351.       STRDUP(name, lib);
  1352.       namelist->name = name;
  1353.       namelist->opens = 1;
  1354.       namelist->flags = flags;
  1355.       namelist->next = scr->funclibs;
  1356.       scr->funclibs = namelist;
  1357.    }
  1358.    return FPL_OK;
  1359. }
  1360.  
  1361. ReturnCode REGARGS CloseLib(struct Data *scr,
  1362.                             char *lib,        /* funclib name or NULL for all */
  1363.                             long flags,       /* options */
  1364.                             long *retvalue)   /* funclib return code */
  1365. {
  1366.    struct MyLibrary *library;
  1367.    struct Library *DOSBase;
  1368.    struct FuncList *namelist=scr->funclibs;
  1369.    struct FuncList *prevlist=NULL;
  1370.    struct FuncList *next;
  1371.    char *command;
  1372.    char *cmd;
  1373.    ReturnCode ret;
  1374.    struct fplStr *string;
  1375.    BPTR seglist;
  1376.  
  1377.    struct ExecBase *SysBase = *(struct ExecBase **)4;
  1378.  
  1379.    library = (struct MyLibrary *)getreg(REG_A6);
  1380.    DOSBase = library->ml_DosBase;
  1381.  
  1382.    GETMEM(command, 60);
  1383.    cmd = command;
  1384.  
  1385.    while(namelist) {
  1386.      if(namelist->flags&FPLLIB_KEEP && namelist->opens==1) {
  1387.        /* This funclib is prevented from being 'soft' closed! */
  1388.        namelist->opens++;
  1389.      }
  1390.      if((!lib || !strcmp(namelist->name, lib)) &&
  1391.         (!--namelist->opens || flags&FPLLIB_FORCE) ) {
  1392.        /* the funclib _is_ opened! */
  1393.  
  1394.        strcpy(command, FPLLIB_SOURCE);
  1395.        strcpy(command+strlen(FPLLIB_SOURCE), lib);
  1396.        seglist = LoadSeg(command); /* load the command! */
  1397.        if(seglist) {
  1398.          strcpy(command, FPLLIB_CLOSECMD);
  1399.          command += strlen(FPLLIB_CLOSECMD);
  1400.     
  1401.          CALL(Ltostr(scr, &string, 10, (long)scr));
  1402.          strcpy(command, string->string);
  1403.          command[string->len]= '\n';   /* add newline */
  1404.          command[string->len+1]= '\0'; /* zero terminate */
  1405.          FREE(string);
  1406.     
  1407.          if(SysBase->SoftVer<36) {
  1408.            /* V33 solution! */
  1409.            char *segment = BADDR(seglist);
  1410.            int (*func)();
  1411. #pragma msg 147 ignore
  1412.            func = segment + 4; /* generates warning */
  1413. #pragma msg 147 warning
  1414.     
  1415.            putreg(REG_A0, (long)cmd);
  1416.            putreg(REG_D0, strlen(cmd));
  1417. #pragma msg 154 ignore
  1418.            *retvalue = (func)(); /* generates warning */
  1419. #pragma msg 154 warning
  1420.          } else /* version 36 or up! */
  1421.            *retvalue = RunCommand(seglist, 4000, cmd, strlen(cmd));
  1422.     
  1423.          UnLoadSeg( seglist );
  1424.        } else {
  1425.          /* we failed loading the command! */
  1426.          *retvalue = FUNCLIB_LOAD;
  1427.        }
  1428.     
  1429.     
  1430.        if(!*retvalue) {
  1431.          next = namelist->next;
  1432.          if(prevlist) /* was there a previous funclib in the list? */
  1433.            prevlist->next=next; /* point it to the next in the list */
  1434.          else
  1435.            scr->funclibs = next; /* point the origin to the next */
  1436.          FREE(namelist->name); /* free name space */
  1437.          FREE(namelist);       /* free struct */
  1438.          namelist = next;
  1439.          continue;
  1440.        }
  1441.      }
  1442.      prevlist = namelist;
  1443.      namelist = namelist->next;
  1444.    }
  1445.  
  1446.    FREE(cmd);
  1447.  
  1448.    return FPL_OK;
  1449. }
  1450.  
  1451. #endif
  1452.  
  1453. static ReturnCode INLINE Ltostr(struct Data *scr,
  1454.                 struct fplStr **string,
  1455.                 long base,
  1456.                 long num)
  1457. {
  1458.   /*
  1459.    * Convert the integer to string with `any base'-convertions.
  1460.    */
  1461.     
  1462.   ReturnCode ret;
  1463.   static const char digits[] = "0123456789abcdefhijklmnopqrstuvwxyz";
  1464.   long is_neg=num<0;
  1465.   long len=0;
  1466.   char buffer[34+sizeof(struct fplStr)];
  1467.   char *bufpoint;  /* the accurate position in the buffer */
  1468.  
  1469.   if(base>strlen(digits)) {
  1470.     CALL(Warn(scr, FPLERR_OUT_OF_REACH));
  1471.     num=strlen(digits); /* reset to maximum */
  1472.   }
  1473.   num=ABS(num);
  1474.     
  1475.   buffer[33+sizeof(struct fplStr)]=CHAR_ASCII_ZERO; /* zero byte termination */
  1476.   bufpoint=&buffer[33+sizeof(struct fplStr)]; /* start digit output position */
  1477.     
  1478.   if(num) {
  1479.     while(num>0) {
  1480.       *--bufpoint= digits[num % base];
  1481.       num /= base;
  1482.       len++;
  1483.     }
  1484.     if(is_neg) {
  1485.       *--bufpoint='-';
  1486.       len++;
  1487.     }
  1488.   } else {
  1489.     *--bufpoint=CHAR_ZERO;
  1490.     len++;
  1491.   }
  1492.  
  1493.   GETMEM(*string, len+sizeof(struct fplStr));
  1494.   strcpy((*string)->string, bufpoint);
  1495.   (*string)->len=len;
  1496.   (*string)->alloc=len;
  1497.   return(FPL_OK);
  1498. }
  1499.  
  1500. /**********************************************************************
  1501.  *
  1502.  * Strtol()
  1503.  *
  1504.  * String to long integer. Code copied and changed from the GNU libc
  1505.  * source code package.
  1506.  *
  1507.  ****/
  1508.  
  1509. long Strtol(char *nptr, long base, char **end)
  1510. {
  1511.   char negative;
  1512.   unsigned long cutoff;
  1513.   unsigned long cutlim;
  1514.   long i;
  1515.   char *s;
  1516.   unsigned char c;
  1517.   char *save;
  1518.   long overflow;
  1519.  
  1520.   if (base < 0 || base == 1 || base > 36)
  1521.     base = 10;
  1522.  
  1523.   s = nptr;
  1524.  
  1525.   /* Skip white space.  */
  1526.   WWSPACE(s);
  1527.  
  1528.   if (*s == CHAR_ASCII_ZERO)
  1529.     return (0);
  1530.  
  1531.   /* Check for a sign.  */
  1532.   else if (*s == CHAR_MINUS) {
  1533.     negative = 1;
  1534.     ++s;
  1535.   } else if (*s == CHAR_PLUS) {
  1536.     negative = 0;
  1537.     ++s;
  1538.   } else
  1539.     negative = 0;
  1540.  
  1541.   if (base == 16 && s[0] == CHAR_ZERO && UPPER(s[1]) == CHAR_UPPER_X)
  1542.     s += 2;
  1543.  
  1544.   /* If BASE is zero, figure it out ourselves.  */
  1545.   if (base == 0)
  1546.     if (*s == '0') {
  1547.       if (UPPER(s[1]) == CHAR_UPPER_X) {
  1548.     s += 2;
  1549.     base = 16;
  1550.       } else
  1551.     base = 8;
  1552.     } else
  1553.       base = 10;
  1554.  
  1555.   /* Save the pointer so we can check later if anything happened.  */
  1556.   save = s;
  1557.  
  1558.   cutoff = ULONG_MAX / (unsigned long int) base;
  1559.   cutlim = ULONG_MAX % (unsigned long int) base;
  1560.  
  1561.   overflow = 0;
  1562.   i = 0;
  1563.   for (c = *s; c; c = *++s) {
  1564.     if (NUMBER(c))
  1565.       c -= '0';
  1566.     else if (ALPHA(c))
  1567.       c = UPPER(c) - CHAR_UPPER_A + 10;
  1568.     else
  1569.       break;
  1570.     if (c >= base)
  1571.       break;
  1572.     /* Check for overflow.  */
  1573.     if (i > cutoff || (i == cutoff && c > cutlim))
  1574.       overflow = 1;
  1575.     else {
  1576.       i *= (unsigned long int) base;
  1577.       i += c;
  1578.     }
  1579.   }
  1580.  
  1581.   *end=s; /* this is the end position of the number */
  1582.  
  1583.   /* Check if anything actually happened.  */
  1584.   if (s == save)
  1585.     return (0);
  1586.  
  1587.   /* Check for a value that is within the range of
  1588.      `unsigned long int', but outside the range of `long int'.  */
  1589.   if (i > (negative ?
  1590.        - (unsigned long int) LONG_MIN :
  1591.        (unsigned long int) LONG_MAX))
  1592.     overflow = 1;
  1593.  
  1594.   if (overflow)
  1595.     return negative ? LONG_MIN : LONG_MAX;
  1596.  
  1597.   /* Return the result of the appropriate sign.  */
  1598.   return (negative ? - i : i);
  1599. }
  1600.